The goal of this analysis is to determine which film properties influence whether a movie is rated above 7 on IMDB. We will use a Generalized Linear Model (GLM) along with other machine learning models for comparison.
2 Data Loading and Cleaning
film <-read.csv("dataset07.csv")# Check structure and missing valuesstr(film)
film_id year length budget
Min. : 33 Min. :1894 Min. : 1.00 Min. : 2.10
1st Qu.:14950 1st Qu.:1958 1st Qu.: 72.00 1st Qu.:10.00
Median :30294 Median :1984 Median : 90.00 Median :12.00
Mean :30045 Mean :1977 Mean : 81.41 Mean :11.95
3rd Qu.:44922 3rd Qu.:1998 3rd Qu.:100.00 3rd Qu.:14.00
Max. :58780 Max. :2005 Max. :399.00 Max. :23.70
votes genre rating
Min. : 5 Action :680 Min. :0.700
1st Qu.: 12 Animation :160 1st Qu.:3.700
Median : 32 Comedy :549 Median :4.700
Mean : 668 Documentary:132 Mean :5.416
3rd Qu.: 120 Drama :654 3rd Qu.:7.800
Max. :103854 Romance : 15 Max. :9.200
Short :105
#Histograms of IMDB ratings ggplot(film, aes(x = rating)) +geom_histogram(binwidth =0.5, fill ="steelblue", color ="black") +labs(x ="IMDB Rating", y ="Frequency", title ="Distribution of IMDB Ratings")
#Barplot of Film Counts by Genreggplot(film, aes(x =factor(genre))) +geom_bar(fill ="skyblue", color ="black") +labs(x ="Genre", y ="Count of Films", title ="Count of Films by Genre")
#Scatterplot of Budget vs Ratingggplot(film, aes(x = budget, y = rating)) +geom_point(color ="steelblue") +labs(x ="Budget (Millions)", y ="IMDB Rating", title ="Rating vs Budget")+geom_hline(yintercept =7, linetype ="dashed", color ="red", size =1)
#Scatterplot of Votes vs RatingVR1 <-ggplot(film, aes(x = votes, y = rating)) +geom_point(alpha =0.5) +labs(title ="Votes vs IMDB Rating", x ="Number of Votes", y ="IMDB Rating")+geom_hline(yintercept =7, linetype ="dashed", color ="red", size =1)#Scatterplot of Log(Votes) vs RatingVR2 <-ggplot(film, aes(x =log(votes), y = rating)) +geom_point(alpha =0.5) +labs(title ="Log(Votes) vs IMDB Rating", x ="Log(Votes)", y ="IMDB Rating")+geom_hline(yintercept =7, linetype ="dashed", color ="red", size =1)VR <-subplot(VR1, VR2)VR
#Scatterplot of Film Length vs RatingLR1 <-ggplot(film, aes(x = length, y = rating)) +geom_point(alpha =0.5) +labs(title =" Film Length vs IMDB Rating", x =" Film Length (Minutes)", y ="IMDB Rating")+geom_hline(yintercept =7, linetype ="dashed", color ="red", size =1)#Scatterplot of log(Film Length) vs RatingLR2 <-ggplot(film, aes(x =log(length), y = rating)) +geom_point(alpha =0.5) +labs(title =" log(Film Length) vs IMDB Rating", x =" Log(Film Length)", y ="IMDB Rating")+geom_hline(yintercept =7, linetype ="dashed", color ="red", size =1)LR <-subplot(LR1, LR2)LR
#Boxplot of Year vs Rating by durationfilm$year_group <-cut(film$year, breaks =c(1894, 1904, 1914, 1924, 1934, 1944, 1954, 1964, 1974, 1984, 1994,2006), labels =c(1:11),right=FALSE) ggplot(film, aes(x = year_group, y = rating, fill = year_group)) +geom_boxplot(na.rm =TRUE) +labs(title ="IMDB Rating by Year Group", x ="Year Group", y ="IMDB Rating") +geom_hline(yintercept =7, linetype ="dashed", color ="red", size =1)+scale_fill_discrete(name ="Year Group", labels =c("1894-1904", "1904-1914", "1914-1924", "1924-1934", "1934-1944", "1944-1954", "1954-1964", "1964-1974", "1974-1984", "1984-1994", "1994-2005"))
4 Creating the Binary Outcome Variable
film$rating_binary <-ifelse(film$rating >7, 1, 0)
5 Correlation Analysis
library(GGally)library(dplyr)# Select only numeric variables, excluding 'film_id' and 'rating'film_numeric <- film %>% dplyr::select(where(is.numeric)) %>% dplyr::select(-film_id, -rating) # Remove 'film_id' and 'rating'# Create the correlation plotggpairs(film_numeric, cardinality_threshold =NULL, title ="Correlation Plot of Numeric Features")
library(corrplot)# Compute correlation matrix without 'film_id' and 'rating'cor_matrix <-cor(film_numeric , use ="complete.obs")# Plot the correlation matrix as a heatmapcorrplot(cor_matrix, method ="color", # Use color shadingtype ="upper", # Show only upper triangletl.cex =0.8, # Adjust text sizetl.col ="black", # Label coloraddCoef.col ="black", # Add correlation values in blacknumber.cex =0.8) # Adjust correlation value size
6 Variable Selection
# Univariate Logistic Regressionvariables <-c("year", "length", "budget", "votes")univariate_results <-sapply(variables, function(var) { model <-glm(rating_binary ~get(var), data = film, family = binomial)summary(model)$coefficients[2,4]})univariate_results
year length budget votes
6.776190e-01 1.842618e-92 1.768745e-31 2.350198e-01
7 Stepwise Regression
full_model <-glm(rating_binary ~ year + length + budget + votes + genre, data = film, family = binomial)stepwise_model <-stepAIC(full_model, direction ="both")
# Logistic Regressionlogit_model <-glm(rating_binary ~ year + budget + votes, data = film, family = binomial)summary(logit_model)
Call:
glm(formula = rating_binary ~ year + budget + votes, family = binomial,
data = film)
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) -8.042e-01 3.758e+00 -0.214 0.831
year -1.065e-03 1.901e-03 -0.560 0.575
budget 1.901e-01 1.628e-02 11.678 <2e-16 ***
votes -1.417e-05 1.231e-05 -1.151 0.250
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
(Dispersion parameter for binomial family taken to be 1)
Null deviance: 2982.5 on 2294 degrees of freedom
Residual deviance: 2830.3 on 2291 degrees of freedom
AIC: 2838.3
Number of Fisher Scoring iterations: 4
# Random Forestrf_model <-randomForest(rating_binary ~ year + budget + votes, data = film, ntree =500, importance =TRUE)print(rf_model)
Call:
randomForest(formula = rating_binary ~ year + budget + votes, data = film, ntree = 500, importance = TRUE)
Type of random forest: regression
Number of trees: 500
No. of variables tried at each split: 1
Mean of squared residuals: 0.208054
% Var explained: 9
varImpPlot(rf_model)
# Lasso Regressionx <-model.matrix(rating_binary ~ year + budget + votes, data = film)[,-1]y <- film$rating_binarylasso_model <-cv.glmnet(x, y, alpha =1, family ="binomial")coef(lasso_model, s ="lambda.min")
4 x 1 sparse Matrix of class "dgCMatrix"
s1
(Intercept) -2.679275e+00
year .
budget 1.709116e-01
votes -1.616137e-06
11 Model Evaluation and Prediction
# Model Performance Metricslogit_pred <-predict(logit_model, type ="response")logit_class <-ifelse(logit_pred >0.5, 1, 0)table(logit_class, film$rating_binary)
logit_class 0 1
0 1375 635
1 108 177
# Random Forest Predictionrf_pred <-predict(rf_model, type ="class")table(rf_pred, film$rating_binary)
Based on the analysis, we found that budget and votes are significant predictors of IMDB ratings. The logistic regression and random forest models provided strong predictive capabilities, while PCA did not significantly improve the model. Further improvements could be made using ensemble methods or additional feature engineering.
Source Code
---title: "Analysis of the properties influencing film rating over 7"subtitle: "student number: 3026884, 2995341, 2897872, 2971937"number-sections: trueformat: html: embed-resources: true code-tools: true pdf: defaulteditor_options: chunk_output_type: consoleexecute: echo: true eval: true warning: false message: false---```{r}#| echo: false#| warning: false#| message: falselibrary(dplyr)library(ggplot2)library(tidyr)library(caret)library(car)library(MASS)library(randomForest)library(glmnet)library(skimr)library(corrplot)library(psych)library(plotly)```## IntroductionThe goal of this analysis is to determine which film properties influence whether a movie is rated above 7 on IMDB. We will use a Generalized Linear Model (GLM) along with other machine learning models for comparison.## Data Loading and Cleaning```{r}film <-read.csv("dataset07.csv")# Check structure and missing valuesstr(film)skim(film)# Remove missing valuesfilm <- film %>%drop_na()# Convert categorical variablesfilm$genre <-as.factor(film$genre)```## Exploratory Data Analysis```{r}summary(film)#Histograms of IMDB ratings ggplot(film, aes(x = rating)) +geom_histogram(binwidth =0.5, fill ="steelblue", color ="black") +labs(x ="IMDB Rating", y ="Frequency", title ="Distribution of IMDB Ratings")``````{r}#Barplot of Film Counts by Genreggplot(film, aes(x =factor(genre))) +geom_bar(fill ="skyblue", color ="black") +labs(x ="Genre", y ="Count of Films", title ="Count of Films by Genre")``````{r}#Scatterplot of Budget vs Ratingggplot(film, aes(x = budget, y = rating)) +geom_point(color ="steelblue") +labs(x ="Budget (Millions)", y ="IMDB Rating", title ="Rating vs Budget")+geom_hline(yintercept =7, linetype ="dashed", color ="red", size =1)``````{r}#Scatterplot of Votes vs RatingVR1 <-ggplot(film, aes(x = votes, y = rating)) +geom_point(alpha =0.5) +labs(title ="Votes vs IMDB Rating", x ="Number of Votes", y ="IMDB Rating")+geom_hline(yintercept =7, linetype ="dashed", color ="red", size =1)#Scatterplot of Log(Votes) vs RatingVR2 <-ggplot(film, aes(x =log(votes), y = rating)) +geom_point(alpha =0.5) +labs(title ="Log(Votes) vs IMDB Rating", x ="Log(Votes)", y ="IMDB Rating")+geom_hline(yintercept =7, linetype ="dashed", color ="red", size =1)VR <-subplot(VR1, VR2)VR``````{r}#Scatterplot of Film Length vs RatingLR1 <-ggplot(film, aes(x = length, y = rating)) +geom_point(alpha =0.5) +labs(title =" Film Length vs IMDB Rating", x =" Film Length (Minutes)", y ="IMDB Rating")+geom_hline(yintercept =7, linetype ="dashed", color ="red", size =1)#Scatterplot of log(Film Length) vs RatingLR2 <-ggplot(film, aes(x =log(length), y = rating)) +geom_point(alpha =0.5) +labs(title =" log(Film Length) vs IMDB Rating", x =" Log(Film Length)", y ="IMDB Rating")+geom_hline(yintercept =7, linetype ="dashed", color ="red", size =1)LR <-subplot(LR1, LR2)LR``````{r}#Boxplot of Year vs Rating by durationfilm$year_group <-cut(film$year, breaks =c(1894, 1904, 1914, 1924, 1934, 1944, 1954, 1964, 1974, 1984, 1994,2006), labels =c(1:11),right=FALSE) ggplot(film, aes(x = year_group, y = rating, fill = year_group)) +geom_boxplot(na.rm =TRUE) +labs(title ="IMDB Rating by Year Group", x ="Year Group", y ="IMDB Rating") +geom_hline(yintercept =7, linetype ="dashed", color ="red", size =1)+scale_fill_discrete(name ="Year Group", labels =c("1894-1904", "1904-1914", "1914-1924", "1924-1934", "1934-1944", "1944-1954", "1954-1964", "1964-1974", "1974-1984", "1984-1994", "1994-2005")) ```## Creating the Binary Outcome Variable```{r}film$rating_binary <-ifelse(film$rating >7, 1, 0)```## Correlation Analysis```{r}library(GGally)library(dplyr)# Select only numeric variables, excluding 'film_id' and 'rating'film_numeric <- film %>% dplyr::select(where(is.numeric)) %>% dplyr::select(-film_id, -rating) # Remove 'film_id' and 'rating'# Create the correlation plotggpairs(film_numeric, cardinality_threshold =NULL, title ="Correlation Plot of Numeric Features")library(corrplot)# Compute correlation matrix without 'film_id' and 'rating'cor_matrix <-cor(film_numeric , use ="complete.obs")# Plot the correlation matrix as a heatmapcorrplot(cor_matrix, method ="color", # Use color shadingtype ="upper", # Show only upper triangletl.cex =0.8, # Adjust text sizetl.col ="black", # Label coloraddCoef.col ="black", # Add correlation values in blacknumber.cex =0.8) # Adjust correlation value size```## Variable Selection```{r}# Univariate Logistic Regressionvariables <-c("year", "length", "budget", "votes")univariate_results <-sapply(variables, function(var) { model <-glm(rating_binary ~get(var), data = film, family = binomial)summary(model)$coefficients[2,4]})univariate_results```## Stepwise Regression```{r}full_model <-glm(rating_binary ~ year + length + budget + votes + genre, data = film, family = binomial)stepwise_model <-stepAIC(full_model, direction ="both")summary(stepwise_model)```## Multicollinearity Check (VIF)```{r}vif_values1 <-vif(full_model)vif_values1vif_values2 <-vif(stepwise_model)vif_values2```## Principal Component Analysis (no need)## Model Comparison```{r}# Logistic Regressionlogit_model <-glm(rating_binary ~ year + budget + votes, data = film, family = binomial)summary(logit_model)# Random Forestrf_model <-randomForest(rating_binary ~ year + budget + votes, data = film, ntree =500, importance =TRUE)print(rf_model)varImpPlot(rf_model)# Lasso Regressionx <-model.matrix(rating_binary ~ year + budget + votes, data = film)[,-1]y <- film$rating_binarylasso_model <-cv.glmnet(x, y, alpha =1, family ="binomial")coef(lasso_model, s ="lambda.min")```## Model Evaluation and Prediction```{r}# Model Performance Metricslogit_pred <-predict(logit_model, type ="response")logit_class <-ifelse(logit_pred >0.5, 1, 0)table(logit_class, film$rating_binary)# Random Forest Predictionrf_pred <-predict(rf_model, type ="class")table(rf_pred, film$rating_binary)```## ConclusionBased on the analysis, we found that budget and votes are significant predictors of IMDB ratings. The logistic regression and random forest models provided strong predictive capabilities, while PCA did not significantly improve the model. Further improvements could be made using ensemble methods or additional feature engineering.
